home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / stream.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  3.2 KB  |  142 lines  |  [TEXT/MPS ]
  1. #open "io";;
  2. #open "exc";;
  3. #open "obj";;
  4. #open "int";;
  5. #open "fstring";;
  6. #open "ref";;
  7.  
  8. type 'a current_value =
  9.     Vcurr of 'a
  10.   | Vundef
  11.   | Veos
  12. ;;
  13.  
  14. type 'a stream =
  15.     Sempty
  16.   | Scons of 'a * 'a stream
  17.   | Sapp of 'a stream * 'a stream
  18.   | Sfunc of (unit -> 'a stream) * unit
  19.   | Sgen of (unit -> 'a) * 'a current_value
  20. ;;
  21.  
  22. let rec stream_peek = function
  23.     Sempty -> raise Parse_failure
  24.   | Scons(x,_) -> x
  25.   | Sapp(s1, s2) as s ->
  26.       begin try
  27.         stream_peek s1
  28.       with Parse_failure ->
  29.         update (repr s) (repr s2);
  30.         stream_peek s
  31.       end
  32.   | Sfunc(f,_) as s ->
  33.       update (repr s) (repr (f ()));
  34.       stream_peek s
  35.   | Sgen(prod,curr) as s ->
  36.       match curr with
  37.         Vcurr x -> x
  38.       | Veos -> raise Parse_failure
  39.       | Vundef ->
  40.           begin try
  41.             let t = prod() in set_obj_field (repr s) 1 (repr (Vcurr t)); t
  42.           with End_of_file | Parse_failure ->
  43.             set_obj_field (repr s) 1 (repr Veos); raise Parse_failure
  44.           end
  45. ;;
  46.  
  47. let rec stream_junk = function
  48.     Scons(_, s') as s ->
  49.       update (repr s) (repr s')
  50.   | Sapp(s1,_) ->
  51.       stream_junk s1
  52.   | Sgen(prod,curr) as s ->
  53.       set_obj_field (repr s) 1 (repr Vundef)
  54.   | _ ->
  55.       ()
  56. ;;
  57.  
  58. let stream_require strm =
  59.   try stream_peek strm with Parse_failure -> raise Parse_error
  60. ;;
  61.  
  62. let parser_require x (strm : 'a stream) =
  63.   try x strm with Parse_failure -> raise Parse_error
  64. ;;
  65.  
  66. (* Other useful functions *)
  67.  
  68. let stream_next s =
  69.   let x = stream_peek s in stream_junk s; x
  70.   (* Don't define stream_next = function [<'x>] -> x because this causes
  71.      a problem with type stamps while compiling stream.ml. *)
  72. ;;
  73.  
  74. let stream_from rf =
  75.    Sgen(rf, Vundef)
  76. ;;
  77.  
  78. let stream_of_string s =
  79.   let i = ref (-1) in
  80.   stream_from
  81.     (fun () ->
  82.       incr i;
  83.       if !i >= string_length s then raise Parse_failure else nth_char s !i)
  84. ;;
  85.  
  86. let stream_of_channel ic =
  87.   stream_from (fun () -> input_char ic)
  88. ;;
  89.  
  90. let do_stream f strm =
  91.   let rec do_rec() =
  92.     f(stream_peek strm); stream_junk strm; do_rec() in
  93.   try
  94.     do_rec()
  95.   with Parse_failure -> ()
  96. ;;
  97.  
  98. let stream_check p strm =
  99.   let x = stream_peek strm in
  100.   if p x then (stream_junk strm; x) else raise Parse_failure
  101. ;;
  102.  
  103. let end_of_stream strm =
  104.   if try stream_peek strm; false with Parse_failure -> true
  105.   then ()
  106.   else raise Parse_failure
  107. ;;
  108.  
  109. let rec stream_get = function
  110.     Sempty -> raise Parse_failure
  111.   | Scons(x,s) -> (x,s)
  112.   | Sapp(s1, s2) as s ->
  113.       let (x,s') as r =
  114.         try
  115.           let (x,s') = stream_get s1 in (x, Sapp(s',s2))
  116.         with Parse_failure ->
  117.           stream_get s2 in
  118.       update (repr s) (repr (Scons(x,s')));
  119.       r
  120.   | Sfunc(f,_) as s ->
  121.       update (repr s) (repr (f()));
  122.       stream_get s
  123.   | Sgen(prod, curr) as s ->
  124.       match curr with
  125.         Vcurr x ->
  126.           let s' = Sgen(prod, Vundef) in
  127.           update (repr s) (repr (Scons (x, s')));
  128.           (x, s')
  129.       | Vundef ->
  130.           begin try
  131.             let t = prod() in
  132.             let s' = Sgen(prod, Vundef) in
  133.             update (repr s) (repr (Scons (t, s')));
  134.             (t, s')
  135.           with End_of_file | Parse_failure ->
  136.             update (repr s) (repr Sempty);
  137.             raise Parse_failure
  138.           end
  139.       | Veos ->
  140.          raise Parse_failure
  141. ;;
  142.